MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 04 - 1988/04.01 Jan 88/typing battle source/TypingBattle Source

Text File | 1987-11-27 | 14.4 KB | 613 lines | [TEXT/PJMM]

{        TypingBattle by Steve Sheets 11/15/87        }

{    Simple Demonstration of Multible Keyboards.        }

PROGRAM TypingBattle;

    USES
        MultiLine;                {Unit to handle simple editing}

    CONST
        MaxAllow = 5;        {Max Number of Players}

        AboutID = 600;        {Various Resource IDs}
        TextID = 600;
        LineID = 601;
        AppleMenuID = 1;
        FileMenuID = 2;
        EditMenuID = 3;

        WindowH = 480;        {Placement Constants}
        VEdge = 40;
        CenterTop = 40;
        Edge = 10;
        Hi = 20;
        PlayOff = 50;
        TTop = -15;
        RTop = 5;
        WTop = 35;

        TimeCount = 180;    {Timer to start round}

{Variables: Menus, Done Flag, Number Players, Main Window, Status of game,}
{    Number of Samples, Number Players done, lots strings, arrays holding Players}
{    Scores, Who's Done, Names & Bus IDs and finally Edit fields holding}
{    Message, Names & Text.}
    VAR
        AppleMenu, FileMenu, EditMenu : MenuHandle;
        Done : boolean;
        theNum : integer;
        MyWindow : WindowPtr;
        Status, NumSamples, NumDone : integer;
        WelStr, ScoreStr, PreStr, WinStr, PressStr : str255;
        NoOneStr, EnterStr, SepStr, theTitle : str255;
        Score : ARRAY[1..MaxAllow] OF integer;
        isDone : ARRAY[1..MaxAllow] OF boolean;
        theName : ARRAY[1..MaxAllow] OF str255;
        theBus : ARRAY[1..MaxAllow] OF integer;
        MessRec : MLRec;
        NameRec, TextRec : ARRAY[1..MaxAllow] OF MLRec;


{Returns Number Of Samples (ie. Number of strings in the STR# resource.}
    FUNCTION GetNumSamples : integer;
        TYPE
            WP = ^integer;
            WH = ^WP;
        VAR
            W : WH;
    BEGIN
        W := POINTER(GetResource('STR#', TextID));
        GetNumSamples := W^^;
        ReleaseResource(POINTER(W));
    END;

{Given M (Longint Message field of Keydown event), return B (Bus ID),}
{    V (Virtual code) & C (Key pressed).}
    PROCEDURE CalcKey (M : longint;
                                    VAR B, V : integer;
                                    VAR C : char);
    BEGIN
        C := Chr(M MOD 256);
        B := (M DIV 65536) MOD 256;
        V := (M DIV 256) MOD 256;
    END;

{Do About Box.}
    PROCEDURE DoAbout;
        VAR
            n : integer;
    BEGIN
        n := Alert(AboutID, NIL);
    END;

{Initialize variables}
    PROCEDURE DoSetup;
    BEGIN
        GetIndString(WelStr, LineID, 1);
        GetIndString(ScoreStr, LineID, 2);
        GetIndString(PreStr, LineID, 3);
        GetIndString(WinStr, LineID, 4);
        GetIndString(PressStr, LineID, 5);
        GetIndString(NoOneStr, LineID, 6);
        GetIndString(theTitle, LineID, 7);
        GetIndString(EnterStr, LineID, 8);
        GetIndString(SepStr, LineID, 9);
        NumSamples := GetNumSamples;


        AppleMenu := GetMenu(AppleMenuID);
        AddResMenu(AppleMenu, 'DRVR');
        InsertMenu(AppleMenu, 0);

        FileMenu := GetMenu(FileMenuID);
        InsertMenu(FileMenu, 0);

        EditMenu := GetMenu(EditMenuID);
        InsertMenu(EditMenu, 0);

        DrawMenuBar;

        InitCursor;

        MyWindow := NIL;
        Done := false;
    END;

{Given an integer H & V, make a centered rectange R.}
    PROCEDURE MakeRect (VAR R : rect;
                                    h, v : integer);
        VAR
            N : integer;
    BEGIN
        N := (screenbits.bounds.right - screenbits.bounds.left - H) DIV 2;
        SetRect(R, N, VEdge, N + H, VEdge + V);
    END;

{Handle Special Keys, return true if none was pressed.  In this case, only}
{    handle Help by calling About Box.  Note the Hex Codes.}
    FUNCTION NotSpecKeys (Virtual : integer) : boolean;
    BEGIN
        IF Virtual = $72 THEN
            BEGIN
                DoAbout;
                NotSpecKeys := false;
            END
        ELSE
            NotSpecKeys := true;
    END;

{Finds out who is playing (ie. set Names & Bus IDs) or quit game (ie. Done true).}
    PROCEDURE GetPlayers;
        CONST
            ConV = 85;
            ConH = 360;
            DLOff = 15;
            kOff = 25;
            kTop = 15;
            kHi = 20;
            LineLeft = 20;
            butBot = -15;
            OKLeft = 90;
            QUITLeft = 210;
            Voff = 15;
        VAR
            tempPort : Grafptr;
            myW : WindowPtr;
            cont, F2 : boolean;
            tempEvent : EventRecord;
            tempWindow : windowptr;
            tempCode, tempVirtual : integer;
            tempChar : char;
            OKcon, QUITcon, tempCon : ControlHandle;
            Lines : ARRAY[1..MaxAllow] OF MLRec;

        PROCEDURE DoBox (V : integer);
            VAR
                R2 : Rect;
        BEGIN
            WITH Lines[V] DO
                BEGIN
                    R2.left := Fr.left - 1;
                    R2.right := Fr.right + 1;
                    R2.top := Fr.top - 1;
                    R2.bottom := Fr.bottom + 1;
                    IF V > theNum THEN
                        PenPat(Gray);
                    FrameRect(R2);
                    PenPat(Black);
                END;
        END;

        PROCEDURE CheckOK;
        BEGIN
            IF (theNum > 0) AND (theNum <= MaxAllow) THEN
                HiliteControl(OKcon, 0)
            ELSE
                HiliteControl(OKcon, 255);
        END;

        PROCEDURE RegKey (V : integer;
                                        C : Char);
            VAR
                count, L : integer;
        BEGIN
            count := 0;
            FOR L := 1 TO theNum DO
                IF theBus[L] = v THEN
                    count := L;
            IF count = 0 THEN
                BEGIN
                    IF (theNum < MaxAllow) AND (Ord(C) >= 32) THEN
                        BEGIN
                            theNum := theNum + 1;
                            theBus[theNum] := V;
                            Lines[theNum].St := ' ';
                            Lines[theNum].St[1] := C;
                            Lines[theNum].Cr := '_';
                            MLreset(Lines[theNum]);
                            DoBox(theNum);
                            CheckOk;
                        END;
                END
            ELSE
                BEGIN
                    MLchar(Lines[count], C);
                    IF Lines[count].St = '' THEN
                        BEGIN
                            IF count <> theNum THEN
                                BEGIN
                                    FOR L := count TO theNum - 1 DO
                                        BEGIN
                                            MLtext(Lines[L], Lines[L + 1].St);
                                            theBus[L] := theBus[L + 1];
                                        END;
                                    Lines[theNum].St := '';
                                END;
                            Lines[theNum].Cr := ' ';
                            MLreset(Lines[theNum]);
                            theNum := theNum - 1;
                            DoBox(theNum + 1);
                            CheckOk;
                        END
                END;
        END;

        PROCEDURE DoGPSetup;
            VAR
                nn, count : integer;
                S : str255;
                Bx : rect;
        BEGIN
            nn := ConV + (MaxAllow * kOff);
            MakeRect(Bx, ConH, nn);
            myW := NewWindow(NIL, Bx, '', true, 1, POINTER(-1), false, 0);
            SetPort(myW);
            SetRect(Bx, OKLeft, nn - 20 + butBot, OKLeft + 60, nn + butBot);
            GetIndString(S, LineID, 10);
            OKcon := NewControl(myW, Bx, S, true, 0, 0, 0, 0, 0);
            SetRect(Bx, QUITLeft, nn - 20 + butBot, QUITLeft + 60, nn + butBot);
            GetIndString(S, LineID, 11);
            QUITcon := NewControl(myW, Bx, S, true, 0, 0, 0, 0, 0);
            cont := false;
            theNum := 0;

            FOR count := 1 TO MaxAllow DO
                BEGIN
                    nn := (count * kOff) + DLOff;
                    SetRect(Bx, LineLeft, nn, ConH - LineLeft, nn + kHi);
                    MLinit(Lines[count], '', '', ' ', Bx, false);
                END;
        END;

    BEGIN
        DoGPSetup;
        CheckOk;
        REPEAT
            SystemTask;
            IF GetNextEvent(everyEvent, tempEvent) THEN
                BEGIN
                    IF tempEvent.what = mouseDown THEN
                        BEGIN
                            F2 := true;
                            IF FindWindow(tempEvent.where, tempWindow) = inContent THEN
                                BEGIN
                                    GlobalToLocal(tempEvent.where);
                                    IF FindControl(tempEvent.where, myW, tempCon) <> 0 THEN
                                        IF TrackCOntrol(tempCon, tempEvent.where, NIL) <> 0 THEN
                                            BEGIN
                                                IF tempCon = QUITcon THEN
                                                    BEGIN
                                                        Done := true;
                                                        F2 := false;
                                                    END
                                                ELSE IF tempCon = OKcon THEN
                                                    BEGIN
                                                        Cont := true;
                                                        FOR tempCode := 1 TO theNum DO
                                                            theName[tempCode] := Lines[tempCode].St;
                                                        F2 := false;
                                                    END;
                                            END
                                        ELSE
                                            F2 := false;
                                END;
                            IF F2 THEN
                                sysbeep(1);
                        END;
                    IF tempEvent.what = keydown THEN
                        BEGIN
                            CalcKey(tempEvent.message, tempCode, tempVirtual, tempChar);
                            IF NotSpecKeys(tempVirtual) THEN
                                RegKey(tempCode, tempChar);
                        END;
                    IF tempEvent.what = updateEvt THEN
                        IF myW = WindowPtr(tempEvent.message) THEN
                            BEGIN
                                GetPort(tempPort);
                                SetPort(myW);
                                BeginUpdate(myW);
                                MoveTo((ConH - StringWidth(EnterStr)) DIV 2, kTop + Voff);
                                DrawString(EnterStr);
                                FOR tempCode := 1 TO MaxAllow DO
                                    BEGIN
                                        MLupdate(Lines[tempCode]);
                                        DoBox(tempCode);
                                    END;
                                DrawControls(myW);
                                EndUpdate(myW);
                                SetPort(tempPort);
                            END;
                END;
        UNTIL cont OR done;
        KillControls(myW);
        DisposeWindow(myW);
    END;

{Dispose Window (if any), get Players (if any), if so create the Window and}
{    Edit fields for the next game.}
    PROCEDURE DoConfigure;
        VAR
            tempRect : Rect;
            flag : boolean;
            count : integer;
            Bx : rect;
    BEGIN
        IF MyWindow <> NIL THEN
            BEGIN
                DisposeWindow(MyWindow);
                MyWindow := NIL;
            END;

        GetPlayers;

        IF NOT done THEN
            BEGIN
                MakeRect(tempRect, WindowH, WTop + (theNum * PlayOff));
                MyWindow := NewWindow(NIL, tempRect, theTitle, false, 1, POINTER(-1), false, 0);
                SetPort(MyWindow);

                Bx.left := Edge;
                Bx.right := WindowH - Edge;
                Bx.top := Edge;
                Bx.bottom := Bx.top + Hi;
                MLinit(MessRec, '', '', ' ', Bx, false);
                FOR count := 1 TO theNum DO
                    BEGIN
                        Bx.top := (count * PlayOff) + TTop;
                        Bx.bottom := Bx.top + Hi;
                        Score[count] := 0;
                        MLinit(NameRec[count], CONCAT(theName[count], ScoreStr), '', ' ', Bx, false);
                        Bx.top := (count * PlayOff) + RTop;
                        Bx.bottom := Bx.top + Hi;
                        MLinit(TextRec[count], '', '', ' ', Bx, true);
                    END;

                ShowWindow(MyWindow);
            END;
    END;

{Start a game by setting status to 1, setting correct message, clearing score,}
{    text and done flags.}
    PROCEDURE DoStart;
        VAR
            count : integer;
            tempPort : GrafPtr;
    BEGIN
        GetPort(tempPort);
        SetPort(MyWindow);
        Status := 1;
        MLtext(MessRec, WelStr);
        FOR count := 1 TO theNum DO
            BEGIN
                Score[count] := 0;
                MLtext(NameRec[count], '0');
                MLtext(TextRec[count], '');
                IsDone[count] := false;
            END;
        SetPort(tempPort);
    END;

{Handle updating the window by calling Edit fields update.}
    PROCEDURE DoUp;
        VAR
            count : integer;
            tempR : rect;
    BEGIN
        SetRect(tempR, 0, 0, 1000, 1000);
        EraseRect(tempR);
        MLupdate(MessRec);
        FOR count := 1 TO theNum DO
            BEGIN
                MLupdate(NameRec[count]);
                MLupdate(TextRec[count]);
            END;
    END;

{Flush the Event buffer of Keydowns.}
    PROCEDURE FlushKeys;
    BEGIN
        FlushEvents(keyDownMask, 0);
    END;

{Depending on Game Status, handle the Key down.  Who is Players number (not}
{    bus ID).  Status 1 is everyone waiting for all Players to press return for}
{    the next round.    Status 2 has everyone playing.}
    PROCEDURE DoKey (Who : integer;
                                    Key : char);
        VAR
            ll : longint;
            Sp : str255;
            count : integer;
            dummy : boolean;
            tempPort : GrafPtr;
    BEGIN
        GetPort(tempPort);
        SetPort(MyWindow);
        SetPort(MyWindow);

        IF (Status = 1) AND (Key = Chr(13)) THEN
            BEGIN
{Player Pressed return.}
                IsDone[who] := true;
                dummy := true;
                FOR count := 1 TO theNum DO
                    dummy := dummy AND IsDone[count];
{If everyone pressed return, wait awhile, then display the Sample, flush any}
{    old key events & go to Status 2.}
                IF dummy THEN
                    BEGIN
                        MLtext(MessRec, PreStr);
                        ll := Tickcount;
                        NumDone := 0;
                        FOR count := 1 TO theNum DO
                            BEGIN
                                IsDone[count] := false;
                                MLtext(TextRec[count], '');
                            END;
                        count := (Random MOD NumSamples) + 1;
                        GetIndString(Sp, TextID, count);
                        WHILE tickcount < ll + TimeCount DO
                            ;
                        MLtext(MessRec, Sp);
                        Status := 2;
                        FlushKeys;
                    END;
            END
        ELSE IF Status = 2 THEN
            BEGIN
{If player has not pressed return,}
                IF NOT IsDone[who] THEN
                    BEGIN
                        MLchar(TextRec[who], Key);
{Handle the Key.}
                        IF Key = Chr(13) THEN
                            BEGIN
{If return, he is done.}
                                NumDone := NumDone + 1;
                                IsDone[who] := true;
                                IF EqualString(TextRec[who].St, MessRec.St, true, false) THEN
                                    BEGIN
{Handle him winning.}
                                        Status := 1;
                                        Score[who] := Score[who] + LENGTH(MessRec.St);
                                        MLtext(MessRec, CONCAT(WinStr, theName[who], PressStr));
                                        NumToString(Score[who], Sp);
                                        MLtext(NameRec[who], Sp);
                                        FOR count := 1 TO theNum DO
                                            IsDone[count] := false;
                                    END
                                ELSE IF NumDone = theNum THEN
                                    BEGIN
{Handle no one winning.}
                                        Status := 1;
                                        MLtext(MessRec, NoOneStr);
                                        FOR count := 1 TO theNum DO
                                            IsDone[count] := false;
                                    END;
                            END;
                    END;
            END;
        SetPort(tempPort);
    END;

{Handle Menu.}
    PROCEDURE MainMenu (tempResult : LONGINT);
        VAR
            tempInteger : integer;
            tempStr : str255;
    BEGIN
        tempInteger := LoWord(tempResult);
        CASE HiWord(tempResult) OF
            AppleMenuID :
                IF tempInteger = 1 THEN
                    DoAbout
                ELSE
                    BEGIN
                        GetItem(appleMenu, tempInteger, tempStr);
                        tempInteger := OpenDeskAcc(tempStr);
                    END;
            FileMenuID :
                IF tempInteger IN [1, 2] THEN
                    BEGIN
                        IF tempInteger = 2 THEN
                            DoConfigure;
                        IF NOT done THEN
                            DoStart;
                    END
                ELSE IF tempInteger = 4 THEN
                    Done := true;
            EditMenuID :
                IF NOT SystemEdit(tempInteger - 1) THEN
                    sysbeep(1);
            OTHERWISE
        END;
        HiliteMenu(0);
    END;

{Main Event Loop.}
    PROCEDURE DoMainLoop;
        VAR
            tempEvent : EventRecord;
            tempWindow : windowptr;
            tempCode, tempBus, tempVirtual : integer;
            tempPort : Grafptr;
            tempChar : Char;
            tempRect : rect;
    BEGIN
        REPEAT
            SystemTask;
            IF GetNextEvent(everyEvent, tempEvent) THEN
                BEGIN
                    CASE tempEvent.what OF
                        mouseDown :
                            BEGIN
                                tempCode := FindWindow(tempEvent.where, tempWindow);
                                CASE tempCode OF
                                    inMenuBar :
                                        MainMenu(MenuSelect(tempEvent.where));
                                    inSysWindow :
                                        SystemClick(tempEvent, tempWindow);
                                    inContent :
                                        IF tempWindow <> FrontWindow THEN
                                            SelectWindow(tempWindow);
                                    inDrag :
                                        IF (MyWindow = tempWindow) AND (tempWindow <> NIL) THEN
                                            BEGIN
                                                SetRect(tempRect, -32000, -32000, 32000, 32000);
                                                DragWindow(tempWindow, tempEvent.where, tempRect);
                                            END;
                                    OTHERWISE
                                END; { of tempCode case }
                            END; { of mouseDown }
                        keydown :
                            BEGIN
                                CalcKey(tempEvent.message, tempBus, tempVirtual, tempChar);
                                IF BitAnd(tempEvent.modifiers, cmdKey) <> 0 THEN
                                    MainMenu(MenuKey(tempChar))
                                ELSE IF NotSpecKeys(tempVirtual) THEN
                                    FOR tempCode := 1 TO theNum DO
                                        IF (theBus[tempCode] = tempBus) AND (theNum > (tempCode - 1)) THEN
                                            DoKey(tempCode, tempChar)
                            END;
                        updateEvt :
                            BEGIN
                                tempWindow := WindowPtr(tempEvent.message);
                                GetPort(tempPort);
                                SetPort(tempWindow);
                                BeginUpdate(tempWindow);
                                IF (tempWindow = MyWindow) AND (tempWindow <> NIL) THEN
                                    DoUp;
                                EndUpdate(tempWindow);
                                SetPort(tempPort);
                            END;
                        OTHERWISE
                    END;
                END;
        UNTIL Done;
    END;

{Game over.}
    PROCEDURE DoQuit;
        VAR
            n : integer;
    BEGIN
        DeleteMenu(AppleMenuID);
        DeleteMenu(FileMenuID);
        DeleteMenu(EditMenuID);
        IF MyWindow <> NIL THEN
            DisposeWindow(MyWindow);
    END;

{Main Body}
BEGIN
    DoSetup;
    DoAbout;
    DoConfigure;
    IF NOT done THEN
        BEGIN
            DoStart;
            DoMainLoop;
        END;
    DoQuit;
END.